Praca domowa 4

Opis:

W wizualizacji wykorzystałem dane od Bi-NGO o liczbie dzieci pozostawianych przez rodziców oraz o liczbie urodzeń w latach 2007-2023, oprócz tego do wygenerowania mapy wykorzystuję plik opisujący granice województw pochodzący ze strony https://gadm.org/download_country.html

Komentarz:

Więcej dzieci jest pozostawianych przez rodziców w województwach zachodnich. W 2023 roku sytuacja zdecydowanie się tam pogorszyła, za to poprawa nastąpiła w mazowieckim, pozytywnie przez wszystkie lata wyróżnia się podkarpackie

opuszczone<-read.csv("C:\\Users\\User\\Desktop\\Programowanie\\Techniki_Wizualizacji_Danych\\hw4\\KacprzakKarol\\porzucone_noworodki.csv",sep=";")
żywe<-read.csv2("C:\\Users\\User\\Desktop\\Programowanie\\Techniki_Wizualizacji_Danych\\hw4\\KacprzakKarol\\Urodzenia żywe w Polsce 2007-2023.csv")

library(ggplot2)
library(dplyr)
library(sf)
library(tidyr)
library(stringi)
library(plotly)


geojson_file <- "gadm41_POL_1.json"

polska <- st_read(geojson_file) %>% 
  mutate(Województwo=tolower(NAME_1))

opuszczone_prom <- opuszczone[,-1] / żywe[,-1]*1000
opuszczone_prom[,ncol(opuszczone_prom)+1]=data.frame(opuszczone$województwo)
opuszczone_prom<-opuszczone_prom %>%
  mutate(Województwo=opuszczone.województwo) %>% 
  select(-opuszczone.województwo)

   
  
opuszczone_prom<-opuszczone_prom  %>% 
  pivot_longer(
    cols = -Województwo,        # Wszystkie kolumny poza "wojewodztwo"
    names_to = "rok",           # Nowa kolumna z latami
    values_to = "wartosc"       # Nowa kolumna z wartościami
) %>% 
  mutate(rok= as.numeric(stri_replace_first_regex(rok, "^X", "")))


polska<-polska %>% 
  inner_join(opuszczone_prom) %>% 
  mutate(ilość=wartosc)

# Tworzenie animacji
fig <- plot_ly(data = polska) %>%
  add_sf(
    stroke = I("black"),
    showlegend = FALSE,
    colors = c("#b5e0f3", "#8c2a64","#e62248"),
    split = ~NAME_1,         
    color = ~ilość,       
    frame = ~rok           
  ) %>% 
  layout(
    title = "Liczba dzieci pozostawionych przez rodziców po narodzinach
     przypadająca na 1000 narodzonych w latach 2007-2023",
    geo = list(
      fitbounds = "locations",
      visible = FALSE
    )
  ) 

fig